#!/usr/bin/perl

###############################################################################
# Author: Gavin Hanover (gavin@subnets.org)
# Project Home: https://code.google.com/p/googpl/
# $Id: goog.pl 105 2015-03-27 18:34:49Z gavin@subnets.org $
###############################################################################

use strict;
use warnings;

use constant VERSION => '$Revision: 105 $';
my $VERSION = VERSION;

use Cwd qw(abs_path cwd);
# we'll assume GoogPl libraries are based off of here. otherwise you'll need -I
my $LIB = abs_path($0);
$LIB =~ s/[^\/]*$//;
chdir($LIB);
use lib cwd();

use GoogPl::GooGl;

use POSIX qw(strftime floor getcwd);
use Module::Reload;
use Net::Server::Daemonize  qw( daemonize );
use POE qw(Component::IRC);
use Config::General qw( ParseConfig );
use Getopt::Std;
use DBI;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
$Getopt::Std::OUTPUT_HELP_VERSION = 1;

my %opts;
if( ! getopts('hvdf:', \%opts) ) { print "$!\n"; exit; }

sub HELP_MESSAGE {
    print " Usage: goog.pl [-f file] [-h] [-d] [-v]
        \033[1m-f file\033[0m: Configuration file. If not specified, goog.conf is assumed.
        \033[1m-d\033[0m: debug.
        \033[1m-h\033[0m: this screen.
        \033[1m-v\033[0m: version information.\n";
    exit;
}
sub VERSION_MESSAGE {
    print "goog.pl ".VERSION."\n";
}

if( $opts{'h'} ) { HELP_MESSAGE(); }
if( $opts{'v'} ) { VERSION_MESSAGE(); exit(); }


# NOTE : debug mode will log pretty much everything, including all chat. Don't
# enable it unless you need it
my $debug = $opts{'d'} ? 1 : 0;

my %flood_count = ();

my $config_file = $opts{'f'} ? $opts{'f'} : 'goog.conf';

if( defined($config_file) && ( ! -e $config_file || ! -r $config_file ) ) {
    print STDERR "Config file '$config_file' does not exist or is not readable.  Use -f to specify a different file.\n";
    exit;
}
# if path is not absolute, make it absolute so we can still find it after
# daemonizing
$config_file = abs_path($config_file);

my %conf;
my $servers;
my $dbfile;
my $dbh;
read_conf();
if( ! scalar keys %conf ) {
    die "Unable to read configuration\n";
}

# log/pid files
my $log_file = $conf{'d'} ? undef : $conf{'home'}."/goog.log"; # leave blank to output to STDOUT
my $pid_file = $conf{'home'}."/goog.pid";

# if you start it as root, you can put whatever user/group here you want. as
# is, we default to your default username/group
# TODO allow for this in goog.conf
if (!$debug) {
    daemonize(getpwuid($<), getgrgid($(), $pid_file);
}

# open log file, or output to stdout if no log file
if( $log_file ) {
    open LOG, ">>$log_file" or die("Error opening log file: $!");
}
else {
    open LOG, ">&STDOUT";
}
print LOG strftime("%F %T", localtime)." STARTUP\n";
LOG->autoflush(1);
my $log = *LOG;

register_modules();
if( ! ref($conf{'module'}) ) { $conf{'module'} = [ $conf{'module'} ]; }

my @commands;

sub register_modules {
    local *LOG = $log;
    @commands = ();
    foreach my $mod (@{$conf{'module'}}) {
        eval {
            eval "require $mod";
            if( $@ ) {
                print LOG "Error loading $mod: $@\n";
                exit;
            }
            push @commands, {'mod' => $mod, $mod->register($dbh)};
        };
        if( $@ ) {
            print LOG "Error registering $mod: $@\n";
            exit;
        }
    }
    GoogPl::GooGl->register($dbh);
    Module::Reload->check;
}

sub sig_hup {
    local *LOG = $log;
    print LOG strftime("%F %T", localtime)." sig_hup: rereading config $config_file\n";
    read_conf();
    register_modules();
}

sub read_conf {
    eval {
        %conf = ParseConfig($config_file);
        foreach my $k (keys %{$conf{'servers'}}) {
            if( ! defined $conf{'servers'}{$k}{'no_uri_title'} ) {
                $conf{'servers'}{$k}{'no_uri_title'} = [];
            }
            if( ! ref($conf{'servers'}{$k}{'no_uri_title'}) ) {
                $conf{'servers'}{$k}{'no_uri_title'} = [ $conf{'servers'}{$k}{'no_uri_title'} ];
            }
        }
        $servers = $conf{'servers'};
        if( ! defined($dbfile) || abs_path($conf{'home'}.'/'.$conf{'dbfile'}) ne $dbfile ) {
            $dbfile = abs_path($conf{'home'}.'/'.$conf{'dbfile'});
        }
        $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","") or die "Unable to connect to database: $!\n";
    };
    if( $@ ) { print LOG $@; }
}

$SIG{'HUP'} = \&sig_hup;

# connect counter
my @disconnect_queue;

sub _start {
    my($kernel, $heap) = @_[KERNEL, HEAP];
    local *LOG = $log;
    print LOG strftime("%F %T", localtime)." _start\n";

    foreach my $k (keys %$heap) {
        my $irc_session = $heap->{$k}->session_id();

        $kernel->post($irc_session => register => qw(all));

        $kernel->post( $irc_session => connect => { } );
    }
    $kernel->alarm('flood_timer' => time + $conf{'flood_timer'});
}

sub irc_433 {
    my($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
    local *LOG = $log;
    print LOG strftime("%F %T", localtime)." irc_433 nick in use\n";
    my $server = $$sender[0]->{'server'};
    srand(time^($$+($$<<15)));

    if (!defined($servers->{$server})) {
        print LOG "You're using a differnet ircserver setting than you have defiend in XML, this breaks things\n";
        die;
    }
    $kernel->post($sender => nick => $servers->{$server}{'ircnick'}.int(rand(10)));
}

sub irc_disconnected {
    my($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
    local *LOG = $log;
    my $server = $$sender[0]->{'server'};
    print LOG strftime("%F %T", localtime)." irc_disconnected $server\n";
    push @disconnect_queue, $server;

    $heap->{'next_disconnect_timer'} = time + 30;
    $kernel->alarm('disconnect_timer' => $heap->{'next_disconnect_timer'});
}

sub irc_socketerr {
    local *LOG = $log;
    my ($kernel, $heap, $sender, $ARG0) = @_[KERNEL, HEAP, SENDER, ARG0];
    my $server = $$sender[0]->{'server'};
    print LOG strftime("%F %%", localtime)." irc_socketerr $server could not connect! I'll try again...\n";

    push @disconnect_queue, $server;
    $heap->{'next_disconnect_timer'} = time + 600;
    $kernel->alarm('disconnect_timer' => $heap->{'next_disconnect_timer'});
}

sub disconnect_timer {
    local *LOG = $log;
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    while( my $server = pop @disconnect_queue ) {
        print LOG strftime("%F %T", localtime)." disconnect_timer: $server\n";
        if (!defined($heap->{$server})) {
            print LOG "You're using a different ircserver than you have defined in XML. This breaks things\n";
            die;
        }
        my $session = $heap->{$server}->session_id();
        $kernel->post( $session => connect => { } );
    }
}

sub flood_timer {
    local *LOG = $log;
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    foreach my $host (keys %flood_count) {
        if( $flood_count{$host} > 0 ) {
            $flood_count{$host} = floor($flood_count{$host} - 1);
        }
    }

    $kernel->alarm('flood_timer' => time + $conf{'flood_timer'});
}

sub ping_timer {
    local *LOG = $log;
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    my $time = time;
    foreach my $server (keys %$servers) {
        print LOG strftime("%F %T", localtime)." ping_timer $server $time\n" if $debug;
        my $session = $heap->{$server}->session_id();
        $kernel->post($session => ping => $time => $server);
    }

    $kernel->alarm('ping_timer' => time + 600);
}

sub irc_001 {
    my ($kernel,$heap, $sender) = @_[KERNEL, HEAP, SENDER];
    local *LOG = $log;

    my $nick = $$sender[0]->{'RealNick'} || $$sender[0]->{'nick'};
    my $server = $$sender[0]->{'server'};
    my $nickserv = $servers->{$server}->{'nickserv'};
    my $nickregister = $servers->{$server}->{'nickregister'};
    my $channels = $servers->{$server}->{'channels'};
    if( ref($channels) ne 'ARRAY' ) { $channels = [ $channels ]; }
# temporary workaround if you are using Config::General >= 2.45 (see bug
# http://rt.cpan.org/Public/Bug/Display.html?id=56532 )
    for( my $i = 0; $i < scalar(@$channels); $i++ ) {
        $channels->[$i] =~ s/^\\//;
    }
    my $umode = $servers->{$server}->{'umode'};

    if( $nickserv ne '' ) { $kernel->post( $sender => privmsg => $nickserv => $nickregister ); }
    $kernel->post( $sender => mode => "$nick $umode" );

    $kernel->post( $sender => join => $_ ) for @$channels;
    
    $kernel->alarm('ping_timer' => time + 600);
}

my $vtime = 0;
sub irc_ctcp_version {
    my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
    local *LOG = $log;

    my ($nickhost, $target, $msgtxt) = @_[ARG0, ARG1, ARG2];
    my ($nick, $ident, $host);
    if ($nickhost =~ /(.*)!(.*)@(.*)/) {
        ($nick, $ident, $host) = ($1, $2, $3);
    } else {
        $nick = $nickhost;
    }
    my $server = $$sender[0]->{'server'};

    # if you use the super-secret "remove flood protection" feature, prevent
    # against stacked ctcp versions. otherwise rely on the built in flood
    # protection (or change >= to > if you don't expect two legit ctcp versions
    # in one second)
    if( time >= $vtime + (defined $servers->{$server}{'flood'} ? $servers->{$server}{'flood'} : 0) ) {
        $kernel->post($sender => ctcpreply => $nick => 'VERSION http://code.google.com/p/googpl/ $Revision: 105 $');
        $vtime = time;
    }
}

sub irc_msg {
    my ($kernel,$sender) = @_[KERNEL, SENDER];
    local *LOG = $log;
    my($nickhost, $target, $msgtxt) = @_[ARG0, ARG1, ARG2];
    print LOG "irc_msg nickhost=$nickhost\n" if(!$debug);
    print LOG "irc_msg nickhost=$nickhost msgtxt=$msgtxt\n" if ($debug);

    $nickhost =~ /(.*)!(.*)@(.*)/;
    my ($nick, $ident, $host) = ($1, $2, $3);

    process_command($kernel, $sender, $nickhost, $nick, $msgtxt);

    return;
}
sub irc_public {
    my ($kernel,$sender) = @_[KERNEL, SENDER];
    local *LOG = $log;
    my($nickhost, $target, $msgtxt) = @_[ARG0, ARG1, ARG2];
    print LOG "irc_public: nickhost=$nickhost msgtxt=$msgtxt\n" if($debug);

    my $channel = $target->[0];

    process_command($kernel, $sender, $nickhost, $channel, $msgtxt);

    return;
}

sub process_command {
    local *LOG = $log;
    my ($kernel, $sender, $nickhost, $target, $msgtxt) = @_;
    my ($nick, $ident, $host);
    if ($nickhost =~ /(.*)!(.*)@(.*)/) {
        ($nick, $ident, $host) = ($1, $2, $3);
    } else {
        $nick = $nickhost;
        $host = $nickhost;
    }
    print LOG "process_command $target: $nickhost $msgtxt\n" if($debug);

    my $server = $$sender[0]->{'server'};
    my $admin = $servers->{$server}{'admin'};
    my $ignore = $servers->{$server}{'ignore'};
    if( $ignore && ref($ignore) ne 'ARRAY' ) { $ignore = [ $ignore ]; }
    if( $ignore && grep( /^\Q$nick\E$/i, @$ignore ) ) { return; }

    if( $nickhost =~ /$admin/ && $msgtxt =~ /^!raw\s+(.*)/ ) {
        my $cmd = $1;
        $kernel->post($sender => 'quote' => $cmd);
        return;
    }
    
    if( $nickhost =~ $admin && $msgtxt =~ /^!rehash/ ) {
        sig_hup();
        $kernel->post($sender => notice => $nick => 'Rehash complete');
        return;
    }

    if( $flood_count{$host} > $conf{'flood_limit'} ) {
        $flood_count{$host} += 0.5;
        print LOG "process_command: flood_limit triggered by $nickhost: ".$flood_count{$host}."\n";
        return;
    }
    
    foreach my $module (@commands) {
        my $pat = $module->{'pat'};
        my $mod = $module->{'mod'};
        if( $msgtxt =~ /$pat/ ) {
            $flood_count{$host}++;
            eval {
                $mod->process_command($kernel, $sender, $nickhost, $target, $msgtxt, %conf, 'dbh'=>$dbh);
            };
            if( $@ ) {
                print LOG "error in process_command: $@";
            }
            return;
        }
    }

    if( $msgtxt =~ /^!help\s*(.*)/ ) {
        $flood_count{$host}++;
        my $cmd = $1;
        if( $cmd ) {
            foreach my $module (@commands) {
                if( $module->{'cmd'} eq $cmd ) {
                    my $mod = $module->{'mod'};
                    foreach my $help ($mod->help) {
                        $kernel->post($sender => notice => $nick => $help);
                        sleep 1; # if it's a big help, we don't want flood notices
                    }
                    return;
                }
            }
        }
        $kernel->post($sender => notice => $nick => "Available commands: ".join(', ', map($_->{'cmd'}, @commands)));
        return;
    }

    if( GoogPl::GooGl->process_command($kernel, $sender, $nickhost, $target, $msgtxt, %conf, 'dbh'=>$dbh) ) {
        $flood_count{$host}++;
    }
    return;
}

sub _default {
    my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];
    my ( $event, $args ) = @_[ ARG0, ARG1 ];
    local *LOG = $log;
    
    $args ||= [];    # Prevents uninitialized-value warnings.
    # this is used to allow modules to start delay/alarm events.
    if( $event =~ /^(GoogPl::.+)->(.+)/ ) {
        $1->$2($kernel);
        if( $@ ) {
            print LOG "$@\n";
        }
    }
    
    # this is used to allow modules to pseudo-register events, enabling things
    # like !seen
    foreach my $module (@commands) {
        my $events = $module->{'events'};
        my $mod = $module->{'mod'};

        next if ! ref($events) eq 'HASH';

        if( $events->{$event} ) {
            my $func = $events->{$event};
            eval {
                $mod->$func($kernel, $sender, $event, $args, %conf, 'dbh'=>$dbh);
            };
            if( $@ ) {
                print LOG "error in $func: $@";
            }
            return;
        }
    }

    print LOG strftime("%F %T", localtime)." _default: $event (@$args)\n" if($debug);
    return 0;
}


my %irc;
while( my ($net, $conf) = each %$servers ) {
    my %args = (
            nick => ${$conf}{'ircnick'}, 
            server => ${$conf}{'ircserver'}, 
            port => ${$conf}{'ircport'}, 
            ircname => ${$conf}{'ircname'},
            username => ${$conf}{'ircuser'},
            Flood => ${$conf}{'flood'}
    );
    if (${$conf}{'ircpassword'}) {
        $args{'Password'} = ${$conf}{'ircpassword'};
    }
    if (${$conf}{'ircssl'}) {
        $args{'UseSSL'} = 1;
    }
    if ($debug) {
        $args{'debug'} = 1;
    }
    $irc{$net} = POE::Component::IRC->spawn(%args) or die "poop!! $net $!";
}
POE::Session->create(
        package_states => [
            'main' => 
            [qw(_start irc_disconnected irc_001 irc_msg irc_public
                irc_ctcp_version
                irc_socketerr irc_433 _default flood_timer disconnect_timer
                ping_timer)],
            ], 
        heap => \%irc, 
);

$poe_kernel->run();

print strftime("%F %T", localtime)." EXITING?\n";
exit 0;
